perm filename COUNT[LSP,SYS] blob
sn#075541 filedate 1974-01-15 generic text, type T, neo UTF8
(SETQ IBASE (SETQ BASE (ADD1 7)))
(DECLARE (SPECIAL OBLIST aaaaa))
(DE QCOUNT (WHICH) (QCOUNT1 OBLIST WHICH))
(DE QCOUNT1 (L WHICH)
(COND ((NULL L) NIL)
((ATOM L) (QCOUNT2 L WHICH))
(T (QCOUNT1 (CAR L)WHICH) (QCOUNT1 (CDR L) WHICH]
(DE QCOUNT2 (THING WHICH)
(PROG (X)
[COND ((SETQ X (GET THING (QUOTE COUNTER)))
(PRINC THING)(PRINC @/ )
(COND ((LESSP (DIFFERENCE (LINELENGTH NIL)(CHRCT)) 13.)
(PRINC @/ )))
(TERPRI (PRINC (MAKNUM X (QUOTE FIXNUM))))) (T NIL]
(COND ((AND X WHICH) (PUTPROP THING NIL @COUNTER]
(DE QNIT NIL
(PROG NIL
(NOUUO NIL) ~Turn all of THESE calls into pushj's!!!!
(PUTPROP @aaaaa NIL @SUBR) ~Dummy function, no counter.
(FOONIT (GETL @aaaaa @(SUBR))) ~Exercise counter code, CALLS→PUSHJS
(QCOUNT T) ~CALLs to PUSHJs in QCOUNT, zero the one
(NOUUO T) ~No more changes, so that patches will work.
(CNTSET (GET @FOOCNT @SUBR))
(REMOB aaaaa)
))
(DEFPROP OPS
(LAMBDA(L)
(PROG NIL
A (COND ((NULL L) (RETURN T)))
(PUTPROP (CAR L) (CADR L) (QUOTE SYM))
(SETQ L (CDDR L))
(GO A)))
FEXPR)
(DSKIN (QCOUNT.LAP))
(QNIT)